home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / tpdev.arc / TPDEV.PAS < prev   
Pascal/Delphi Source File  |  1991-09-27  |  5KB  |  159 lines
  1.   { DOS character device driver written entirely in TP 6 }
  2.  
  3.   { Written by D.J. Murdoch for the public domain, May 1991 }
  4.  
  5.   {$S-,F-}         { Stack checking wouldn't work here, and we assume near calls
  6. }
  7.   {$M $1000,0,0}   { We can't use the heap and don't use the stack.  This
  8.                      setting doesn't really matter though, since you normally
  9.                      won't run TPDEV }
  10.  
  11.   program tpdev;
  12.  
  13.   uses opint;  { OPro interrupt services, needed for stack switching }
  14.  
  15.   procedure strategy_routine(bp:word); interrupt; forward;
  16.   procedure interrupt_routine(bp:word); interrupt; forward;
  17.  
  18.   procedure header;  { Here's the trick:  an assembler routine in the
  19.                        main program, guaranteed to be linked first in the
  20.                        .EXE file!! }
  21.   assembler;
  22.   asm
  23.     dd $FFFFFFFF    { next driver }
  24.     dw $8000        { attributes of simple character device }
  25.     dw offset strategy_routine
  26.     dw offset interrupt_routine
  27.     db 'TPDEVICE'
  28.   end;
  29.  
  30.   const
  31.     stDone = $100;
  32.     stBusy = $200;
  33.  
  34.     cmInit = 0;
  35.     cmInput= 4;
  36.     cmInput_no_wait = 5;
  37.     cmInput_status = 6;
  38.     cmInput_flush = 7;
  39.     cmOutput = 8;
  40.     cmOutput_Verify = 9;
  41.     cmOutput_status = 10;
  42.     cmOutput_flush = 11;
  43.  
  44.   type
  45.     request_header = record
  46.       request_length : byte;
  47.       subunit: byte;
  48.       command_code : byte;
  49.       status : word;
  50.       reserved: array[1..8] of byte;
  51.       case byte of
  52.       cmInit : (num_units : byte;
  53.                 first_free : pointer;
  54.                 args : ^char;
  55.                 drive_num : byte;
  56.                );
  57.       cmInput :  { also used for output }
  58.                  (media_descriptor : byte;
  59.                  buffer : pointer;
  60.                  byte_count : word);
  61.       cmInput_no_wait : (next_char : char);
  62.     end;
  63.  
  64.   var
  65.     local_stack : array[1..4000] of byte;
  66.     end_of_stack : byte;
  67.     request : ^request_header;
  68.     line : string;
  69.  
  70.   procedure handler(var regs : intregisters);
  71.   { This routine is called by the strategy routine, and handles all requests.
  72.     The data segment is okay, and we're running on the local_stack so we've got
  73.     plenty of space, but remember:
  74.      ****** The initialization code for SYSTEM and all other units hasn't
  75.             ever been called!!  ********
  76.   }
  77.   begin
  78.     with request^ do
  79.     begin
  80.       case command_code of
  81.       cmInit: begin
  82.                 first_free := ptr(dseg,ofs(saveint75)+4); { Last thing in the
  83. data
  84.                                                             segment in TP6 }
  85.                                                           { No heap!! }
  86.                 status := stDone;
  87.                 line := 'TPDRIVER successfully initialized.';
  88.               end;
  89.       cmInput: begin
  90.                  if byte_count > length(line) then
  91.                    byte_count := length(line);
  92.                  move(line[1],buffer^,byte_count);
  93.                  line := copy(line,byte_count+1,255);
  94.                  status := stDone;
  95.                end;
  96.       cmInput_no_wait:
  97.                begin
  98.                  if length(line) > 0 then
  99.                  begin
  100.                    next_char := line[1];
  101.                    status := stDone;
  102.                  end
  103.                  else
  104.                    status := stBusy;
  105.                end;
  106.       cmInput_Status,cmOutput_Status,cmInput_Flush,cmOutput_Flush:
  107.                status := stDone;
  108.  
  109.       cmOutput,cmOutput_Verify:
  110.                begin
  111.                  if byte_count + length(line) > 255 then
  112.                    byte_count := 255 - length(line);
  113.                  move(buffer^,line[length(line)+1],byte_count);
  114.                  line[0] := char(byte(byte_count+length(line)));
  115.                  status := stDone;
  116.                end;
  117.       end;
  118.     end;
  119.   end;
  120.  
  121.   procedure RetFar; assembler;
  122.   { Replacement for the IRET code that ends the interrupt routines below }
  123.   asm
  124.     mov sp,bp
  125.     pop bp
  126.     pop es
  127.     pop ds
  128.     pop di
  129.     pop si
  130.     pop dx
  131.     pop cx
  132.     pop bx
  133.     pop ax
  134.     retf
  135.   end;
  136.  
  137.   procedure strategy_routine(bp:word);
  138.   var
  139.     regs : intregisters absolute bp;
  140.   begin
  141.     with regs do
  142.       request := ptr(es,bx);
  143.     RetFar;
  144.   end;
  145.  
  146.   procedure interrupt_routine(bp:word);
  147.   var
  148.     regs : intregisters absolute bp;
  149.   begin
  150.     SwapStackandCallNear(Ofs(handler),@end_of_stack,regs);
  151.     RetFar;
  152.   end;
  153.  
  154.   begin
  155.     writeln('TPDEVICE - DOS device driver written *entirely* in Turbo Pascal.');
  156.     writeln('Install using DEVICE=TPDEV.EXE in CONFIG.SYS.');
  157.     request := @header;  { Need a reference to pull in the header. }
  158.   end.
  159.